home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / TOROID.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  15.6 KB  |  521 lines
  1. 10  'TOROID - 20 NOV 93 rev. 28 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  IF PROG$=""THEN GO$=EX$ ELSE GO$=PROG$
  4. 40  COMMON EX$,PROG$
  5. 50  CLS:KEY OFF
  6. 60  COLOR 7,0,1
  7. 70  PI=3.14159
  8. 80  DIM T$(10,4)         'core material - powdered iron
  9. 90  DIM CT(16,14)        'core size - powdered iron
  10. 100  DIM F$(8,3)          'core material -ferrite
  11. 110  DIM CF(7,12)         'core size - ferrite
  12. 120  DIM GA(40)
  13. 130    K=(0.46/0.005)^(1/39)    'AWG increment multiplier
  14. 140    FOR Z=1 TO 40
  15. 150     N=Z+3
  16. 160     GA(Z)=0.46/K^N
  17. 170    NEXT Z
  18. 180  UL$=STRING$(80,205)
  19. 190  E$=STRING$(79,32)    'blank line
  20. 200  GOSUB 4310       'load data
  21. 210  '
  22. 220  '.....start
  23. 230  CLS
  24. 240  '.....clear variables - except L, which may be chained from another program
  25. 250  B=0:C=0:F=0:M=0:N=0:R=0:IR=0:X=0:Y=0:XC=0:T=0:U=0
  26. 260  OD=0:ID=0:TH=0:AF=0:AL=0:ER=0:NP=0:FQ=0
  27. 270  '
  28. 280  COLOR 15,2
  29. 290  PRINT " TOROID INDUCTOR CALCULATOR";TAB(57);"by George Murphy VE3ERP ";
  30. 300  COLOR 1,0:PRINT STRING$(80,223);
  31. 310  COLOR 7,0
  32. 320  PRINT " Press number in < > to choose standard units of measure:"
  33. 330  PRINT UL$;
  34. 340  PRINT "  < 1 >  Metric"
  35. 350  PRINT "  < 2 >  U.S.A./Imperial"
  36. 360  PRINT UL$;
  37. 370  PRINT "    or press < 0 > to EXIT....."
  38. 380  Z$=INKEY$
  39. 390  IF Z$="0"THEN CLS:CHAIN GO$
  40. 400  IF Z$="1"THEN UM=25.4:UM$="mm.":GOTO 430
  41. 410  IF Z$="2"THEN UM=1:UM$="in.":GOTO 430
  42. 420  GOTO 380
  43. 430  PRINT UL$;
  44. 440  IF L THEN Z$="4":GOTO 600         'if L chained from another program
  45. 450  PRINT " Press number in < > to:"
  46. 460  PRINT UL$;
  47. 470  PRINT "  < 3 >  CALCULATE flux density"
  48. 480  PRINT "  < 4 >  DESIGN a toroidal inductor"
  49. 490  PRINT "  < 5 >  FIND inductance of a toroidal device"
  50. 500  PRINT "  < 6 >  CHECK inductance of a toroidal device with a grid-dip meter"
  51. 510  PRINT "  < 7 >  Determine PROPERTIES of a toroidal inductor."
  52. 520  PRINT "  < 8 >  SEE a table of Amidon core materials"
  53. 530  PRINT "  < 9 >  SEE a table of Amidon core sizes"
  54. 540  PRINT UL$;
  55. 550  PRINT TAB(3);"NOTE:";
  56. 560  PRINT TAB(10);
  57. 570  PRINT "All wire calculations are for enamelled solid copper wire."
  58. 580  Z$=INKEY$
  59. 590  IF Z$="3"THEN GOSUB 1550:FLUX=1:GOTO 680
  60. 600  IF Z$="4"THEN GOSUB 1550:GOTO 1950
  61. 610  IF Z$="5"THEN GOSUB 1550:FLUX=0:GOTO 680
  62. 620  IF Z$="6"THEN 3060
  63. 630  IF Z$="7"THEN 3340
  64. 640  IF Z$="8"THEN SEE=1:GOTO 1550
  65. 650  IF Z$="9"THEN 4170
  66. 660  GOTO 580
  67. 670  '
  68. 680  '.....calculate flux density
  69. 690  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  70. 700  COLOR 7,0:LOCATE 3
  71. 710  M=ASC(Z$)-96
  72. 720  PRINT " AMIDON ";
  73. 730  IF M<=10 THEN C$="T":M$=T$(M,1)+" Powdered-Iron":MM=VAL(M$):D$=T$(M,4)
  74. 740  IF M>10 THEN C$="F":M=M-10:M$=F$(M,1)+" Ferrite":MM=VAL(M$):D$=F$(M,3)
  75. 750  PRINT M$;" toroid cores for ";D$;" MHz"
  76. 760  PRINT UL$;
  77. 770  PRINT " Press letter in < > to select core size:";
  78. 780  PRINT TAB(50);"(dimensions in ";UM$;")"
  79. 790  PRINT STRING$(41,205);TAB(49);"O.D.     I.D.     Thk."
  80. 800  IF C$="T"THEN 830
  81. 810  IF C$="F"THEN 920
  82. 820  '
  83. 830  FOR Z=1 TO 16
  84. 840  PRINT "< ";CHR$(Z+96);" >  ";"T-";CT(Z,1);"-";MM;
  85. 850  IF CT(Z,M+1)>0 THEN 870
  86. 860  PRINT TAB(21);"Not available in ";T$(M,1);"-mix":GOTO 900
  87. 870  PRINT TAB(23);USING "####.#";CT(Z,M+1);:PRINT " >H/100 turns";
  88. 880  IF UM=1 THEN MM$="#####.###" ELSE MM$="#######.#"
  89. 890  PRINT TAB(44);USING MM$;CT(Z,12)*UM;CT(Z,13)*UM;CT(Z,14)*UM
  90. 900  NEXT Z:GOTO 1000
  91. 910  '
  92. 920  FOR Z=1 TO 7
  93. 930  PRINT "< ";CHR$(Z+96);" >  ";"FT-";CF(Z,1);"-";MM;
  94. 940  IF CF(Z,M+1)>0 THEN 960
  95. 950  PRINT TAB(23);"Not available in ";F$(M,1);"-mix":GOTO 980
  96. 960  PRINT TAB(23);USING "####.#";CF(Z,M+1);:PRINT " mH/1000 turns";
  97. 970  PRINT TAB(44);USING "#####.###";CF(Z,10);CF(Z,11);CF(Z,12)
  98. 980  NEXT Z
  99. 990  '
  100. 1000  IF C$="T"THEN C=112
  101. 1010  IF C$="F"THEN C=103
  102. 1020  Z$=INKEY$
  103. 1030  IF Z$=""THEN 1020
  104. 1040  IF ASC(Z$)<96 OR ASC(Z$)>C THEN 1020
  105. 1050  C=ASC(Z$)-96
  106. 1060  IF C$="T"THEN SIZE=CT(C,1):AL=CT(C,M+1):MIX=VAL(T$(M,1)):T$="T -"
  107. 1070  IF C$="T"THEN OD=CT(C,12):ID=CT(C,13):TH=CT(C,14):X=100:L$=">H"
  108. 1080  IF C$="F"THEN SIZE=CF(C,1):AL=CF(C,M+1):MIX=VAL(F$(M,1)):T$="FT -"
  109. 1090  IF C$="F"THEN OD=CF(C,10):ID=CF(C,11):TH=CF(C,12):X=1000:L$="mH"
  110. 1100  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  111. 1110  U$="#####.###"
  112. 1120  AE=(OD*2.54-ID*2.54)/2*TH*2.54   'section area in square cm.
  113. 1130  PRINT TAB(9);"AMIDON core number.............. ";T$;SIZE;"-";MIX
  114. 1140  PRINT TAB(9);"Outside diameter............OD = ";USING U$;OD*UM;
  115. 1150  PRINT " ";UM$
  116. 1160  PRINT TAB(9);"Inside diameter.............ID = ";USING U$;ID*UM;
  117. 1170  PRINT " ";UM$
  118. 1180  PRINT TAB(9);"Thickness...................TH = ";USING U$;TH*UM;
  119. 1190  PRINT " ";UM$
  120. 1200  PRINT TAB(9);"Section area................AE = ";USING U$;AE;:PRINT " cm<UNK! {FD22}>
  121. 1210  PRINT TAB(9);"Mfr's Inductance Index......AL = ";USING U$;AL
  122. 1220  IF FLUX=0 THEN 1260
  123. 1230  INPUT " ENTER: Applied AC voltage..........ER = ";ER
  124. 1240  IF ER=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 1230
  125. 1250  LOCATE CSRLIN-1:PRINT "       ";:LOCATE CSRLIN,42:PRINT USING U$;ER
  126. 1260  INPUT " ENTER: Number of core turns........NP = ";NP
  127. 1270  IF NP=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 1260
  128. 1280  LOCATE CSRLIN-1:PRINT "       ";:LOCATE CSRLIN,42:PRINT USING U$;NP
  129. 1290  L=(NP/X)^2*AL
  130. 1300  PRINT TAB(9);"Inductance...................L = ";USING U$;L;:PRINT " ";L$
  131. 1310  IF FLUX=0 THEN 1420
  132. 1320  INPUT " ENTER: Operating Fqcy. in MHz......FQ = ";FQ
  133. 1330  IF FQ=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 1320
  134. 1340  LOCATE CSRLIN-1:PRINT "       ";:LOCATE CSRLIN,42:PRINT USING U$;FQ
  135. 1350  F=FQ*10^6   'frequency in Hertz
  136. 1360  INPUT " ENTER: DC current in amps(if any)..DC = ";DC
  137. 1370  LOCATE CSRLIN-1:PRINT "       ";:LOCATE CSRLIN,42:PRINT USING U$;DC
  138. 1380  '
  139. 1390  B=ER*10^8/(4.44*F*NP*AE)
  140. 1400  IF DC THEN B=B+NP*DC*AL/(10*AE)
  141. 1410  PRINT TAB(9);"Flux density in Gauss .......B = ";USING U$;B
  142. 1420  PRINT UL$;
  143. 1430  GOSUB 5080  'screendump
  144. 1440  'IF FLUX THEN 1490
  145. 1450  LOCATE 25,1:PRINT STRING$(79,32);
  146. 1460  COLOR 14,6
  147. 1470  LOCATE 25,16:PRINT " Do you want to find another inductance?   (y/n) ";
  148. 1480  COLOR 7,0
  149. 1490  Z$=INKEY$
  150. 1500  IF Z$="n"OR Z$="N"THEN 5050   'end without screen dump
  151. 1510  IF Z$="y"OR Z$="Y"THEN GOSUB 1550:GOTO 680
  152. 1520  GOTO 1490
  153. 1530  GOTO 5020  'end
  154. 1540  '
  155. 1550  '.....select a core
  156. 1560  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  157. 1570  PRINT " The last digit(s) in an AMIDON code number constitute";
  158. 1580  PRINT " the Mix Number."
  159. 1590  IF SEE=1 THEN 1610
  160. 1600  PRINT " Press code letter in < > below to indicate AMIDON core material:"
  161. 1610  PRINT UL$;
  162. 1620  IF SEE=1 THEN 1640
  163. 1630  PRINT " CODE";
  164. 1640  PRINT TAB(8);"MIX #";TAB(16);"CORE MATERIAL";TAB(31);"COLOR";
  165. 1650  PRINT TAB(40);"PERMEABILITY";TAB(55);"FQCY.RANGE (MHz)"
  166. 1660  '
  167. 1670  '.....print table
  168. 1680  FOR Z=1 TO 18
  169. 1690  IF SEE=1 THEN PRINT "        ";:GOTO 1710
  170. 1700   PRINT " < ";CHR$(Z+96);" >  ";
  171. 1710    IF Z<=10 THEN 1730
  172. 1720    IF Z>10 THEN 1770
  173. 1730  T$=T$(Z,1)
  174. 1740  IF LEN(T$)<2 THEN T$=" "+T$
  175. 1750   PRINT T$;TAB(16);"Powdered Iron";
  176. 1760   PRINT TAB(31);T$(Z,2);TAB(40);T$(Z,3);TAB(55)T$(Z,4);:GOTO 1810
  177. 1770  F$=F$(Z-10,1)
  178. 1780  IF LEN(F$)<2 THEN F$=" "+F$
  179. 1790   PRINT F$;TAB(16);"Ferrite";
  180. 1800   PRINT TAB(40);F$(Z-10,2);TAB(55)F$(Z-10,3);
  181. 1810   IF SEE=1 THEN PRINT TAB(72);"       ";:GOTO 1830
  182. 1820   PRINT TAB(72);"< ";CHR$(Z+96);" >  ";
  183. 1830  NEXT Z
  184. 1840  COLOR 0,7:LOCATE 25,7:PRINT " ( <f> recommended for 1-11 MHz.   ";
  185. 1850  PRINT "<g> recommended for 10-30 MHz. ) ";
  186. 1860  COLOR 7,0
  187. 1870  IF SEE=1 THEN 1930
  188. 1880  Z$=INKEY$:IF Z$=""THEN 1880
  189. 1890  IF ASC(Z$)<=78 AND ASC(Z$)>=65 THEN Z$=CHR$(ASC(Z$)+32)
  190. 1900  IF ASC(Z$)>=97 AND ASC(Z$)<=114 THEN 1920
  191. 1910  GOTO 1880
  192. 1920  RETURN
  193. 1930  GOTO 5020   'end
  194. 1940  '
  195. 1950  '.....display selected item
  196. 1960  VIEW PRINT 3 TO 24:CLS:VIEW PRINT
  197. 1970  COLOR 15,2:LOCATE 1,18:PRINT "CORE SELECTION      "
  198. 1980  COLOR 7,0:LOCATE 3
  199. 1990  M=ASC(Z$)-96
  200. 2000  IF M<=10 THEN C$="T"
  201. 2010  IF M>10 THEN C$="F":M=M-10
  202. 2020  PRINT " CORE:";
  203. 2030    IF C$="T"THEN 2050
  204. 2040    IF C$="F"THEN 2070
  205. 2050   PRINT TAB(8);T$(M,1);TAB(16);"Powdered Iron";TAB(31);T$(M,2);
  206. 2060   PRINT TAB(40);T$(M,3);TAB(55)T$(M,4);" MHz":DASH=VAL(T$(M,1)):GOTO 2090
  207. 2070   PRINT TAB(8);F$(M,1);TAB(16);"Ferrite";
  208. 2080   PRINT TAB(40);F$(M,2);TAB(55)F$(M,3);" Mhz":DASH=VAL(F$(M,1))
  209. 2090  PRINT UL$;
  210. 2100  '
  211. 2110  '.....input data
  212. 2120  IF L THEN 2150
  213. 2130  IF C$="T"THEN INPUT" ENTER: Desired inductance in >H.......";L
  214. 2140  IF C$="F"THEN INPUT" ENTER: Desired inductance in mH.......";L
  215. 2150  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  216. 2160  IF UM=1 THEN 2190
  217. 2170  INPUT " ENTER: Wire diameter (mm) ";R
  218. 2180  R=R/25.4/2:GOTO 2210
  219. 2190  INPUT " ENTER: Wire size (AWG#) ";GA$
  220. 2200  R=GA(VAL(GA$))/2
  221. 2210  CLS
  222. 2220  IF C$="T"THEN 2250
  223. 2230  IF C$="F"THEN 2610
  224. 2240  '
  225. 2250  '.....powdered iron core calculations
  226. 2260  COLOR 15,1,1
  227. 2270  IF UM=1 THEN D$=" inches "ELSE D$="SOUNDSOUND mm.SOUNDSOUND"
  228. 2280  PRINT "   AMIDON";TAB(14);"CALLVARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUND";D$;"SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLORCALL";
  229. 2290  PRINT TAB(39);">H/100CALL";TAB(47);"No.of turns CALL";
  230. 2300  IF UM=1 THEN M$=CHR$(34)+" " ELSE M$="mm"
  231. 2310  PRINT TAB(61);"Wire^";USING "##.###";R*2*UM;:PRINT M$;
  232. 2320  IF GA$<>""THEN PRINT " AWG ";GA$;:GOTO 2340
  233. 2330  PRINT "       ";
  234. 2340  PRINT "Core # - mix CALL";TAB(17);"O.D.";TAB(25);"I.D.";TAB(32)"Thick CALL";
  235. 2350  PRINT TAB(40);"turnsCALL";TAB(47);"for";L;">H";TAB(59);"CALL";
  236. 2360  PRINT " Maximum Turns       ";
  237. 2370  PRINT UL$;
  238. 2380  LOCATE CSRLIN-1,14:PRINT "STEP"
  239. 2390  LOCATE CSRLIN-1,38:PRINT "STEP"
  240. 2400  LOCATE CSRLIN-1,45:PRINT "STEP"
  241. 2410  LOCATE CSRLIN-1,59:PRINT "STEP"
  242. 2420  COLOR 7,0,1
  243. 2430  FOR Z=1 TO 16
  244. 2440  PRINT "T-";CT(Z,1);"-";DASH;
  245. 2450  IF CT(Z,M+1)=0 THEN PRINT TAB(14);"not available in this mix":GOTO 2540
  246. 2460  N=100*SQR(L/CT(Z,M+1))      'number of turns
  247. 2470  IF UM=1 THEN M$="####.###"ELSE M$="######.#"
  248. 2480  PRINT TAB(13);USING M$;CT(Z,12)*UM;CT(Z,13)*UM;CT(Z,14)*UM;
  249. 2490  PRINT USING "######.#";CT(Z,M+1);
  250. 2500  PRINT USING "######.##";N;
  251. 2510  IR=CT(Z,13)/2:GOSUB 2940        'IR = I.D./2
  252. 2520  PRINT TAB(59);USING "####";MAX;
  253. 2530  IF N<MAX THEN PRINT " approx."ELSE PRINT "  CORE TOO SMALL"
  254. 2540  NEXT Z
  255. 2550  COLOR 15,1,1:PRINT UL$;:COLOR 7,0,1
  256. 2560  PRINT " T-37 cores recommended for power levels up to 10 watts."
  257. 2570  PRINT " T-50 cores recommended for power levels of 10 to 50 watts."
  258. 2580  PRINT " T-68 cores recommended for power levels of 50 to 100 watts."
  259. 2590  GOTO 5020  'end
  260. 2600  '
  261. 2610  '.....ferrite core calculations
  262. 2620  COLOR 15,1,1
  263. 2630  IF UM=1 THEN D$=" inches "ELSE D$="SOUNDSOUND mm.SOUNDSOUND"
  264. 2640  PRINT "   AMIDON";TAB(14);"CALLVARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUND";D$;"SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLORCALL";
  265. 2650  PRINT TAB(39);"mH/1000";TAB(46);"CALLNo.of turnsCALL";
  266. 2660  IF UM=1 THEN M$=CHR$(34)+" " ELSE M$="mm"
  267. 2670  PRINT TAB(60);"Wire^";USING "##.###";R*2;:PRINT M$;
  268. 2680  IF GA$<>""THEN PRINT " AWG ";GA$;" ";:GOTO 2700
  269. 2690  PRINT "        ";
  270. 2700  PRINT "Core # - mix CALL";TAB(17);"O.D.";TAB(25);"I.D.";TAB(32)"Thick CALL";
  271. 2710  PRINT TAB(40);"turns";TAB(46);"CALLfor";L;"mH";TAB(58);"CALL";
  272. 2720  PRINT " Maximum Turns        ";
  273. 2730  PRINT UL$;
  274. 2740  LOCATE CSRLIN-1,14:PRINT "STEP"
  275. 2750  LOCATE CSRLIN-1,38:PRINT "STEP"
  276. 2760  LOCATE CSRLIN-1,46:PRINT "STEP"
  277. 2770  LOCATE CSRLIN-1,58:PRINT "STEP"
  278. 2780  COLOR 7,0,1
  279. 2790  FOR Z=1 TO 7:IF CF(Z,M+1)=0 THEN 2900
  280. 2800  IF CF(Z,M+1)=0 THEN PRINT TAB(14);"not available in this mix":GOTO 2900
  281. 2810  N=1000*SQR(L/CF(Z,M+1))      'number of turns
  282. 2820  PRINT"FT-";CF(Z,1);"-";DASH;
  283. 2830  PRINT TAB(14);USING "###.###";CF(Z,10);
  284. 2840  PRINT USING "####.###";CF(Z,11);CF(Z,12);
  285. 2850  PRINT USING "#######.#";CF(Z,M+1);
  286. 2860  PRINT USING "######.##";N;
  287. 2870  IR=CF(Z,11)/2:GOSUB 2940        'ir = I.D./2
  288. 2880  PRINT TAB(59);USING "####";MAX;
  289. 2890  IF N<MAX THEN PRINT " approx."ELSE PRINT "  CORE TOO SMALL"
  290. 2900  NEXT Z
  291. 2910  COLOR 15,1,1:PRINT UL$;:COLOR 7,0,1
  292. 2920  GOTO 5020  'end
  293. 2930  '
  294. 2940  '.....max. no.of turns
  295. 2950  IF IR<R THEN MAX=0:GOTO 3040
  296. 2960  IF IR>=R+1.4142*R THEN 3010
  297. 2970  MAX=4
  298. 2980  IF IR< R+R*1.4142 THEN MAX=3
  299. 2990  IF IR< R+R*1.1547 THEN MAX=2
  300. 3000  GOTO 3040
  301. 3010  X=SQR((IR-R)^2-R^2)
  302. 3020  Y=ATN(R/X)
  303. 3030  MAX=PI/Y*0.9    '.9 is provisional factor
  304. 3040  RETURN
  305. 3050  '
  306. 3060  '.....check inductance
  307. 3070  VIEW PRINT 3 TO 24:CLS:VIEW PRINT
  308. 3080  COLOR 15,2:LOCATE 1,18:PRINT "CHECK        "
  309. 3090  COLOR 7,0:LOCATE 3
  310. 3100  PRINT TAB(9);
  311. 3110  PRINT "Refer to the ARRL HANDBOOK FOR THE RADIO AMATEUR for method of";
  312. 3120  PRINT TAB(9);
  313. 3130  PRINT "checking the inductance of a toroidal device with a grid dip meter."
  314. 3140  PRINT
  315. 3150  PRINT TAB(9);
  316. 3160  PRINT "This program will perform all the necessary calculations:"
  317. 3170  PRINT UL$;
  318. 3180  INPUT " ENTER: Capacitance of known capacitor in pF .......";C
  319. 3190  IF C=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 3180
  320. 3200  LOCATE CSRLIN-1:PRINT "       ";:LOCATE CSRLIN,53:PRINT USING "#####.###";C
  321. 3210  C=C/10^6    '>F
  322. 3220  INPUT " ENTER: Measured frequency in MHz...................";F
  323. 3230  IF F=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 3220
  324. 3240  LOCATE CSRLIN-1:PRINT "       ";:LOCATE CSRLIN,53:PRINT USING "#####.###";F
  325. 3250  XC=1/(2*PI*F*C):XL=XC
  326. 3260  L=XL/(2*PI*F)
  327. 3270  PRINT "        Reactance of known capacitor in ohms........";
  328. 3280  PRINT USING "#####.###";XC
  329. 3290  PRINT "        Inductance of toroidal device in >H.........";
  330. 3300  PRINT USING "#####.###";L
  331. 3310  PRINT UL$;
  332. 3320  GOTO 5020  'end
  333. 3330  '
  334. 3340  '.....properties of a toroidal inductor
  335. 3350  VIEW PRINT 3 TO 24:CLS:VIEW PRINT
  336. 3360  COLOR 15,2:LOCATE 1,18:PRINT "PROPERTIES      "
  337. 3370  COLOR 7,0:LOCATE 3
  338. 3380  U$="#####.###"
  339. 3390  GOTO 3470
  340. 3400  '
  341. 3410  LOCATE CSRLIN-1:PRINT "       ":LOCATE CSRLIN-1,46:PRINT USING U$;Z*UM;
  342. 3420  RETURN
  343. 3430  '
  344. 3440  LOCATE CSRLIN-1:PRINT "       ":LOCATE CSRLIN-1,46:PRINT USING U$;Z
  345. 3450  RETURN
  346. 3460  '
  347. 3470  PRINT " ENTER: OUTER diameter of core...............";UM$;
  348. 3480  INPUT OD:OD=OD/UM
  349. 3490  IF OD=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 3470
  350. 3500  Z=OD:GOSUB 3410:PRINT " ";UM$
  351. 3510  PRINT " ENTER: INNER diameter of core...............";UM$;
  352. 3520  INPUT ID:ID=ID/UM
  353. 3530  IF ID=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 3510
  354. 3540  Z=ID:GOSUB 3410:PRINT " ";UM$
  355. 3550  PRINT " ENTER: THICKNESS of core....................";UM$;
  356. 3560  INPUT T:T=T/UM
  357. 3570  IF T=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 3550
  358. 3580  Z=T:GOSUB 3410:PRINT " ";UM$
  359. 3590  AREA=(OD-ID)/2*T*2.54^2
  360. 3600  PRINT "        Cross-section area of ring...........";USING U$;AREA;
  361. 3610  PRINT " cm<UNK! {FD22}>
  362. 3620  LG=(OD+ID)/2*PI*2.54
  363. 3630  PRINT "        Length of flux path..................";USING U$;LG;
  364. 3640  PRINT " cm."
  365. 3650  '
  366. 3660  '.....determine missing factor
  367. 3670  PRINT UL$;
  368. 3680  PRINT " Any two of the following factors must be known ";
  369. 3690  PRINT "to complete calculations."
  370. 3700  PRINT " Press number in < > to indicate ";:COLOR 15,0:PRINT "UNKNOWN";
  371. 3710  COLOR 7,0:PRINT " factor:"
  372. 3720  PRINT UL$;
  373. 3730  PRINT "  < 1 >  > factor (permeability) of core"
  374. 3740  PRINT "  < 2 >  Number of primary turns"
  375. 3750  PRINT "  < 3 >  Inductance of device in >H"
  376. 3760  Z$=INKEY$:IF Z$="" THEN 3760
  377. 3770  IF Z$="1"THEN U=-1:GOTO 3810
  378. 3780  IF Z$="2"THEN NP=-1:GOTO 3810
  379. 3790  IF Z$="3"THEN L=-1:GOTO 3810
  380. 3800  GOTO 3760
  381. 3810  VIEW PRINT 9 TO 24:CLS:VIEW PRINT:LOCATE 9
  382. 3820  '
  383. 3830  '.....input permeability factor
  384. 3840  IF U=-1 THEN 3890
  385. 3850  INPUT " ENTER: Effective core permeability.........>=";U
  386. 3860  IF U=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 3850
  387. 3870  Z=U:GOSUB 3440
  388. 3880  '
  389. 3890  '.....input number of turns
  390. 3900  IF NP=-1 THEN 3950
  391. 3910  INPUT " ENTER: Number of primary turns...............";NP
  392. 3920  IF NP=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 3910
  393. 3930  Z=NP:GOSUB 3440
  394. 3940  '
  395. 3950  '.....input inductance
  396. 3960  IF L=-1 THEN 4010
  397. 3970  IF L<>-1 THEN INPUT " ENTER: Inductance in >H......................";L
  398. 3980  IF L=0 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 3970
  399. 3990  Z=L:GOSUB 3440
  400. 4000  '
  401. 4010  '.....end printout
  402. 4020  LOCATE 11
  403. 4030  IF U<>-1 THEN 4060
  404. 4040  U=L/(0.4*PI*NP^2*AREA/LG*10^-2)
  405. 4050  PRINT "        Effective core permeability........>=";USING U$;U
  406. 4060  IF L<>-1 THEN 4090
  407. 4070  L=0.4*PI*NP^2*U*AREA/LG*10^-2
  408. 4080  PRINT "        Inductance in >H.....................";USING U$;L
  409. 4090  IF NP<>-1 THEN 4120
  410. 4100  NP=SQR(L/(0.4*PI*U*AREA/LG*10^-2))
  411. 4110  PRINT "        Number of primary turns..............";USING U$;NP
  412. 4120  AL=L/(NP^2*10^-4)
  413. 4130  PRINT "        >H per 100 turns (Mfr.'s AL no.)....EQV";USING U$;AL
  414. 4140  PRINT UL$
  415. 4150  GOTO 5020  'end
  416. 4160  '
  417. 4170  '.....core size table
  418. 4180  CLS
  419. 4190  IF UM=1 THEN U$="#######.###"ELSE U$="#########.#"
  420. 4200  PRINT " CORE SIZE     O.D.(";UM$;")  I.D.(";UM$;")  THK.(";UM$;")"
  421. 4210  FOR Z=1 TO 16:PRINT " T -";CT(Z,1);
  422. 4220  PRINT TAB(12);USING U$;CT(Z,12)*UM,CT(Z,13)*UM,CT(Z,14)*UM
  423. 4230  NEXT Z
  424. 4240  FOR Z=1 TO 7:PRINT " FT -";CF(Z,1);
  425. 4250  PRINT TAB(12);USING U$;CF(Z,10)*UM,CF(Z,11)*UM,CF(Z,12)*UM;
  426. 4260  IF Z<7 THEN PRINT ""
  427. 4270  NEXT Z
  428. 4280  GOTO 5020  'end
  429. 4290  END
  430. 4300  '
  431. 4310  'LOAD DATA........
  432. 4320  '.....core description - powdered iron
  433. 4330  DATA 41,Green,>=75,---
  434. 4340  DATA 26,Yel/Wh,>=75,0-1
  435. 4350  DATA 3,Grey,>=35,0.05-0.5
  436. 4360  DATA 15,Red/Wh,>=25,0.1-2.0
  437. 4370  DATA 1,Blue,>=20,0.5-5.0
  438. 4380  DATA 2,Red,>=10,1-30
  439. 4390  DATA 6,Yellow,>=8,10-90
  440. 4400  DATA 10,Black,>=6,60-150
  441. 4410  DATA 12,Grn/Wh,>=3,100-200
  442. 4420  DATA 0,Tan,>=1,150-300
  443. 4430   FOR Z=1 TO 10:FOR Y=1 TO 4:READ T$(Z,Y):NEXT Y:NEXT Z
  444. 4440  '
  445. 4450  '.....inductance index & core dimensions - powdered iron
  446. 4460  DATA 200,755,895,425,0,250,120,100,0,0,0
  447. 4470  DATA 2,1.25,.55
  448. 4480  DATA 184,1640,1640,720,0,500,240,195,0,0,0
  449. 4490  DATA 1.84,.95,.71
  450. 4500  DATA 157,970,970,420,360,320,140,115,0,0,0
  451. 4510  DATA 1.57,.95,.57
  452. 4520  DATA 130,785,785,330,250,200,110,96,0,0,15
  453. 4530  DATA 1.3,.78,.437
  454. 4540  DATA 106,900,900,405,345,325,135,116,0,0,19
  455. 4550  DATA 1.06,.56,.437
  456. 4560  DATA 94,590,590,248,200,160,84,70,58,32,10.6
  457. 4570  DATA .942,.56,.312
  458. 4580  DATA 80,450,450,180,170,115,55,45,32,22,8.5
  459. 4590  DATA .795,.495,.25
  460. 4600  DATA 68,420,420,195,180,115,57,47,32,21,7.5
  461. 4610  DATA .69,.37,.19
  462. 4620  DATA 50,320,320,175,135,100,49,40,31,18,6.4
  463. 4630  DATA .5,.303,.19
  464. 4640  DATA 44,229,360,180,160,105,52,42,33,0,6.5
  465. 4650  DATA .44,.229,.159
  466. 4660  DATA 37,308,275,120,90,80,40,30,25,15,4.9
  467. 4670  DATA .375,.205,.128
  468. 4680  DATA 30,375,325,140,93,85,43,36,25,16,6
  469. 4690  DATA .307,.151,.128
  470. 4700  DATA 25,225,0,100,85,70,34,27,19,12,4.5
  471. 4710  DATA .255,.12,.096
  472. 4720  DATA 20,175,0,90,65,52,27,22,16,10,3.5
  473. 4730  DATA .2,.088,.067
  474. 4740  DATA 16,130,0,61,55,44,22,19,13,8,3
  475. 4750  DATA .16,.078,.06
  476. 4760  DATA 12,112,0,60,50,43,20,17,12,7.5,3
  477. 4770  DATA .125,.062,.05
  478. 4780   FOR Z=1 TO 16:FOR Y=1 TO 14:READ CT(Z,Y):NEXT Y:NEXT Z
  479. 4790  '
  480. 4800  '.....core description - ferrite
  481. 4810  DATA 68,>=20,---
  482. 4820  DATA 63,>=40,15-25
  483. 4830  DATA 67,>=40,15-25
  484. 4840  DATA 61,>=125,.2-10
  485. 4850  DATA 43,>=950,.01-1
  486. 4860  DATA 77,>=2000,.001-1
  487. 4870  DATA 72,>=2000,.001-1
  488. 4880  DATA 75,>=5000,.001-1
  489. 4890   FOR Z=1 TO 8:FOR Y=1 TO 3:READ F$(Z,Y):NEXT Y:NEXT Z
  490. 4900  '
  491. 4910  '.....inductance index & core dimensions - ferrite
  492. 4920  DATA 23,4,7.9,7.9,24.8,188,396,396,995,.23,.12,.06
  493. 4930  DATA 37,8.8,19.7,19.7,55.3,420,884,884,2220,.375,.187,.125
  494. 4940  DATA 50,11,22,22,68.8,523,1100,1100,2740,.5,.281,.188
  495. 4950  DATA 82,11.7,22.4,22.4,73.3,557,1172,1172,2940,.825,.52,.25
  496. 4960  DATA 114,12.7,25.4,25.4,79.3,603,1270,1270,3170,1.142,.748,.295
  497. 4970  DATA 140,-,-,45,140,952,2240,2240,-,1.4,.9,.5
  498. 4980  DATA 240,-,-,53,171,1239,-,3133,-,2.4,1.4,.5
  499. 4990   FOR Z=1 TO 7:FOR Y=1 TO 12:READ CF(Z,Y):NEXT Y:NEXT Z
  500. 5000  RETURN
  501. 5010  '
  502. 5020  '.....end
  503. 5030  GOSUB 5080
  504. 5040  IF EX$<>GO$ THEN CLS:CHAIN GO$
  505. 5050  L=0:GOTO 220
  506. 5060  END
  507. 5070  '
  508. 5080  'HARDCOPY
  509. 5090  GOSUB 5200:LOCATE 25,2:COLOR 14,6
  510. 5100  PRINT " Press 1 to print screen, 2 to print screen & ";
  511. 5110  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  512. 5120  Z$=INKEY$:IF Z$="3"THEN GOSUB 5200:RETURN
  513. 5130  IF Z$="1"OR Z$="2"THEN GOSUB 5200:GOTO 5150
  514. 5140  GOTO 5120
  515. 5150  FOR QX=1 TO 24:FOR QY=1 TO 80
  516. 5160  LPRINT CHR$(SCREEN(QX,QY));
  517. 5170  NEXT QY:NEXT QX
  518. 5180  IF Z$="2"THEN LPRINT CHR$(12)
  519. 5190  GOTO 5090
  520. 5200  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  521.